home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1987 September / 64er_Magazin_87-09_1987_Markt__Technik_de_Side_A.d64 / ba.huepfer v1.0 (.txt) next >
Encoding:
Commodore BASIC  |  1987-01-01  |  6.9 KB  |  236 lines
  1. 10 goto300
  2. 20 :
  3. 30 deffnx(xx)=x:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  4. 40 deffny(yy)=y:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  5. 50 return
  6. 60 :
  7. 100 rem *******************************
  8. 110 rem *                             *
  9. 120 rem *        huepfer v1.0         *
  10. 130 rem *                             *
  11. 140 rem *      geschrieben von:       *
  12. 150 rem *                             *
  13. 160 rem *        jochen topf          *
  14. 170 rem *       gluemerstr. 34        *
  15. 180 rem *       7800 freiburg         *
  16. 190 rem *       tel.:0761-700701      *
  17. 200 rem *                             *
  18. 210 rem *******************************
  19. 220 :
  20. 230 :
  21. 297 rem--------------------------------
  22. 298 rem variablen fuer sys-aufrufe
  23. 299 rem--------------------------------
  24. 300 ifa=0thena=a+1:load"mc.huepfer*",8,1
  25. 310 poke55,0:poke56,140
  26. 320 hn=49152:hf=49155:hc=49161:hp=49182
  27. 330 mc=49164:mp=49185
  28. 340 hs=49170:hl=49167:di=49173
  29. 350 cl=49158
  30. 360 fx=49176:fy=49179
  31. 397 rem--------------------------------
  32. 398 rem vorbereitung
  33. 399 rem--------------------------------
  34. 400 m=0:poke53280,15:bi=0
  35. 410 f1=1:f2=6:f3=0:f4=1:f5=6:f6=2
  36. 420 sysfx,"x":sysfy,"y"
  37. 430 r$=chr$(13)
  38. 497 rem--------------------------------
  39. 498 rem menue
  40. 499 rem--------------------------------
  41. 500 poke53281,6:print"[147]   huepfer v1.0"
  42. 510 print"    (1) ...............ende"
  43. 520 print"    (2) .........bild laden"
  44. 530 print"    (3) .directory anzeigen"
  45. 540 print"    (4) .........neues bild"
  46. 545 ifbi=0then590
  47. 550 print"    (5) ........bild zeigen"
  48. 560 print"    (6) ...bild abspeichern"
  49. 570 print"    (7) ......weiterrechnen"
  50. 580 print"    (8) .parameter anzeigen"
  51. 585 print"    (9) .............farben"
  52. 590 print"   was darf's sein ?"
  53. 600 getei$:ifei$=""then600
  54. 610 ei=val(ei$)
  55. 620 ifbi=0andei>4then600
  56. 630 oneigoto700,2300,900,1000,800,2200,1500,1600,1900
  57. 640 goto600
  58. 697 rem--------------------------------
  59. 698 rem ende
  60. 699 rem--------------------------------
  61. 700 print"[147] wirklich beenden ?? (j/n)"
  62. 710 getei$:ifei$="n"then500
  63. 720 ifei$<>"j"then710
  64. 730 print"[147] tschuess !!":end
  65. 797 rem--------------------------------
  66. 798 rem bild anzeigen
  67. 799 rem--------------------------------
  68. 800 ifm=0thensyshc,f1,f2:goto820
  69. 810 sysmc,f3,f4,f5,f6
  70. 820 syshn,m:getei$:ifei$=""then820
  71. 830 ifei$<>"c"thensyshf:goto500
  72. 840 syscl:goto820
  73. 897 rem--------------------------------
  74. 898 rem directory anzeigen
  75. 899 rem--------------------------------
  76. 900 print"[147]":sysdi
  77. 910 open15,8,15:input#15,a1$,a2$,a3$,a4$
  78. 920 close15:print:print""a1$" "a2$" "a3$" "a4$
  79. 930 poke198,0:wait198,1
  80. 940 goto500
  81. 997 rem--------------------------------
  82. 998 rem neues bild
  83. 999 rem--------------------------------
  84. 1000 print"[147] neues bild berechnen"
  85. 1010 print" ===================="
  86. 1020 print" hires- oder multicolour-bild ? (h/m)"
  87. 1030 getei$:ifei$="m"thenm=1:goto1060
  88. 1040 ifei$<>"h"then1030
  89. 1050 m=0
  90. 1060 print" bitte formel fuer x eingeben:"
  91. 1070 input" --> xx=";x$
  92. 1080 print" bitte formel fuer y eingeben:"
  93. 1090 input" --> yy=";y$
  94. 1100 ifm=0then1130
  95. 1110 print" nach wieviel schritten soll die farbe   gewechselt werden ?"
  96. 1120 print" --> ";:au=1:zm=7:gosub1800:sc=au
  97. 1130 print"[147] neues bild berechnen"
  98. 1140 print" ===================="
  99. 1150 print" verschiebung in x-richtung ?"
  100. 1160 print" --> ";:au=0:zm=5:gosub1800:vx=au
  101. 1170 print" verschiebung in y-richtung ?"
  102. 1180 print" --> ";:au=0:zm=5:gosub1800:vy=au
  103. 1190 print" vergroesserung horizontal ?"
  104. 1200 print" --> ";:au=1:zm=8:gosub1800:mx=au
  105. 1210 print" vergroesserung vertikal ?"
  106. 1220 print" --> ";:au=1:zm=8:gosub1800:my=au
  107. 1221 print"[147] automatisches abspeichern ?  (j/n)"
  108. 1222 getei$:ifei$="n"thenis=0:goto1227
  109. 1223 ifei$<>"j"then1222
  110. 1224 print" nach wieviel iterationen ?":print" ---> ";
  111. 1225 au=10000:zm=12:gosub1800:is=au
  112. 1226 print" name des bildes ?":input" --->";n3$
  113. 1227 print" nach wieviel iterationen abrechen ?":print" --> ";
  114. 1228 au=10000:zm=12:gosub1800:ib=au
  115. 1230 print" alles o.k. ?? (j/n)"
  116. 1240 getei$:ifei$="n"then500
  117. 1250 ifei$<>"j"then1240
  118. 1260 print"[147] das bild wird jetzt berechnet !!":bi=1
  119. 1270 fori=0to500:next
  120. 1280 sysfx,x$:sysfy,y$
  121. 1290 :
  122. 1300 syscl:ifm=0thensyshc,f1,f2:goto1320
  123. 1310 sysmc,f3,f4,f5,f6
  124. 1320 syshn,m
  125. 1330 it=0:x=0:y=0:xx=0:yy=0:i1=0:lf=1:si=0:az=0
  126. 1340 sx=vx/(m+1)+159-m*80:sy=vy+99:nx=mx/(m+1):ny=my
  127. 1350 gosub30
  128. 1360 xx=fnx(x):yy=fny(y):x=xx:y=yy
  129. 1370 zx=x*nx+sx:zy=y*ny+sy
  130. 1380 ifzx<0orzx>319-m*160orzy<0orzy>199then1410
  131. 1390 ifm=0thensyshp,zx,zy:goto1410
  132. 1400 sysmp,lf,zx,zy
  133. 1410 it=it+1:i1=i1+1:ifi1=sctheni1=0:lf=lf+1
  134. 1420 iflf=4thenlf=1
  135. 1425 si=si+1:ifsi=isthensi=0:az=az+1:na$=n3$+str$(az):at=1:goto2220
  136. 1427 ifit=ibthensyshf:goto500
  137. 1430 getei$:ifei$=""then1360
  138. 1440 syshf:goto500
  139. 1497 rem-------------------------------
  140. 1498 rem weiterrechnen
  141. 1499 rem-------------------------------
  142. 1500 print"[147] abbrechen nach wieviel iterationen ?":print" ---> ";
  143. 1510 au=ib:zm=12:gosub1800:ib=au
  144. 1520 ifm=0thensyshc,f1,f2:goto1540
  145. 1530 sysmc,f3,f4,f5,f6
  146. 1540 syshn,m:goto1340
  147. 1597 rem-------------------------------
  148. 1598 rem parameter anzeigen
  149. 1599 rem-------------------------------
  150. 1600 print"[147] iterationen:"it
  151. 1610 print" xx="x$:print" yy="y$
  152. 1620 print" modus: ";:ifm=0thenprint"hires":goto1640
  153. 1630 print"multicolour"
  154. 1640 print" x="x,"y="y
  155. 1650 print" verschiebung  : x="vx,"y="vy
  156. 1660 print" vergroesserung: x="mx,"y="my
  157. 1670 ifis=0then1676
  158. 1672 print" autom. speichern nach"is"iterationen"
  159. 1675 print" unter dem namen:";n3$
  160. 1676 print" nach"ib"iterationen wird abgebrochen"
  161. 1680 ifm=1thengosub1700
  162. 1690 print"[210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210]";
  163. 1692 print"    bitte irgendeine taste druecken";
  164. 1695 poke198,0:wait198,1:goto500
  165. 1697 rem-------------------------------
  166. 1698 rem multicolour-parameter
  167. 1699 rem-------------------------------
  168. 1700 print" farbwechsel nach"sc"iterationen"
  169. 1710 print" aktuelle farbe :"lf
  170. 1790 return
  171. 1797 rem-------------------------------
  172. 1798 rem eingabe-routine (zahlen)
  173. 1799 rem-------------------------------
  174. 1800 zl=0:au$="":poke204,0
  175. 1810 getei$:ifei$=""then1810
  176. 1820 ei=asc(ei$)
  177. 1830 ifzl<zmandei>44andei<58andei<>47thenprintei$;:zl=zl+1:au$=au$+ei$
  178. 1840 ifei=20andzl>0thenprintei$;:zl=zl-1:au$=left$(au$,len(au$)-1)
  179. 1850 ifei<>13then1810
  180. 1860 ifzl>0thenau=val(au$)
  181. 1865 poke204,1
  182. 1870 pe=1024+40*peek(214)+peek(211)
  183. 1880 ifpeek(pe)>127thenpokepe,peek(pe)-128
  184. 1890 print:return
  185. 1897 rem-------------------------------
  186. 1898 rem farben anzeigen & aendern
  187. 1899 rem-------------------------------
  188. 1900 print"[147] hiresfarben:":print" [163][163][163][163][163][163][163][163][163][163][163][163]"
  189. 1910 print" hintergrundfarbe :";f2
  190. 1920 print" vordergrundfarbe :";f1
  191. 1930 print" multicolourfarben:":print" [163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  192. 1940 print" hintergrundfarbe :";f3
  193. 1950 print" farbe 1          :";f4
  194. 1960 print" farbe 2          :";f5
  195. 1970 print" farbe 3          :";f6
  196. 1980 print" (1) ........hiresfarben aendern"
  197. 1990 print" (2) ..multicolourfarben aendern"
  198. 2000 print" (3) ..........zurueck zum menue"
  199. 2010 getei$:ifei$=""then2010
  200. 2020 ei=val(ei$):oneigoto2040,2070,500
  201. 2030 goto2010
  202. 2040 print"[147] vordergrundfarbe :";:au=f2:zm=2:gosub1800:f2=au
  203. 2050 print" hintergrundfarbe :";:au=f1:zm=2:gosub1800:f1=au
  204. 2060 goto1900
  205. 2070 print"[147] hintergrundfarbe :";:au=f3:zm=2:gosub1800:f3=au
  206. 2080 print" farbe 1          :";:au=f4:zm=2:gosub1800:f4=au
  207. 2090 print" farbe 2          :";:au=f5:zm=2:gosub1800:f5=au
  208. 2100 print" farbe 3          :";:au=f6:zm=2:gosub1800:f6=au
  209. 2110 goto1900
  210. 2197 rem-------------------------------
  211. 2198 rem bild abspeichern
  212. 2199 rem-------------------------------
  213. 2200 print"[147] wie soll das bild heissen ?"
  214. 2210 input" -->";na$:at=0
  215. 2220 n1$="hp."+na$:n2$="hd."+na$+",s,w"
  216. 2230 syshs,n1$,8
  217. 2240 open2,8,2,n2$
  218. 2250 print#2,x$:print#2,y$:print#2,n3$
  219. 2260 print#2,m;r$;it;r$;i1;r$;lf;r$;x;r$;y;r$;vx;r$;vy;r$;mx;r$;my;r$;sc;r$;
  220. 2265 print#2,si;r$;is;r$;az;r$;ib;r$
  221. 2270 close2
  222. 2280 ifat=0thengoto910
  223. 2290 goto1427
  224. 2297 rem-------------------------------
  225. 2298 rem bild laden
  226. 2299 rem-------------------------------
  227. 2300 print"[147] wie heisst das bild ?"
  228. 2310 input" -->";na$
  229. 2320 n1$="hp."+na$:n2$="hd."+na$+",s,r"
  230. 2330 syshl,n1$,8
  231. 2340 open2,8,2,n2$
  232. 2350 input#2,x$:input#2,y$:input#2,n3$
  233. 2360 input#2,m,it,i1,lf,x,y,vx,vy,mx,my,sc,si,is,az,ib
  234. 2370 close2:sysfx,x$:sysfy,y$
  235. 2380 bi=1:goto910
  236.